home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp4.arc / SENDYMOD.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-10-04  |  15.8 KB  |  454 lines
  1. (*----------------------------------------------------------------------*)
  2. (*        Send_Ymodem_File --- Uploads file with Ymodem                 *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Send_Ymodem_File;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Send_Ymodem_File                                     *)
  10. (*                                                                      *)
  11. (*     Purpose:    Uploads files using Ymodem                           *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Send_Ymodem_File;                                             *)
  16. (*                                                                      *)
  17. (*     Calls:   KeyPressed                                              *)
  18. (*              Async_Send                                              *)
  19. (*              Async_Receive_With_TimeOut                              *)
  20. (*              Check_KeyBoard                                          *)
  21. (*              RvsVideoOn                                              *)
  22. (*              RvsVideoOff                                             *)
  23. (*              Wait_For_Nak                                            *)
  24. (*              Perform_Upload                                          *)
  25. (*                                                                      *)
  26. (*      Remarks:                                                        *)
  27. (*                                                                      *)
  28. (*         This routine performs wildcard directory searches and        *)
  29. (*         implements the Ymodem batch file transfer protocol.          *)
  30. (*                                                                      *)
  31. (*         Note that the header constructed here contains the           *)
  32. (*         file name, file size, and file creation time.                *)
  33. (*                                                                      *)
  34. (*----------------------------------------------------------------------*)
  35.  
  36. VAR
  37.    File_Pattern : AnyStr;
  38.    SFileName    : PACKED ARRAY[1..11] OF CHAR;
  39.    Int_Ch       : INTEGER;
  40.    Ch           : CHAR;
  41.    CheckSum     : INTEGER;
  42.    EndFName     : BOOLEAN;
  43.    I            : INTEGER;
  44.    J            : INTEGER;
  45.    Local_Save   : Saved_Screen_Ptr;
  46.    File_Entry   : Directory_Record;
  47.    Ack_OK       : BOOLEAN;
  48.    Use_CRC      : BOOLEAN;
  49.    OK_File      : BOOLEAN;
  50.  
  51. (*----------------------------------------------------------------------*)
  52. (*              Check_KeyBoard --- Check for keyboard input             *)
  53. (*----------------------------------------------------------------------*)
  54.  
  55. PROCEDURE Check_KeyBoard;
  56.  
  57. BEGIN (* Check_KeyBoard *)
  58.                                    (* If Alt_R found, stop transfer *)
  59.    IF KeyPressed THEN
  60.       BEGIN
  61.  
  62.          READ( Kbd, Ch );
  63.  
  64.          IF ( Ch = CHR( ESC ) ) AND KeyPressed THEN
  65.             BEGIN
  66.                READ( Kbd, Ch );
  67.                IF ORD( Ch ) = Alt_S THEN
  68.                   BEGIN
  69.                      Stop_Send := TRUE;
  70.                      WRITELN('  Alt_S accepted, transfer cancelled.');
  71.                   END;
  72.             END;
  73.  
  74.       END;
  75.  
  76. END   (* Check_KeyBoard *);
  77.  
  78. (*----------------------------------------------------------------------*)
  79. (*          Make_Ymodem_Header --- Send special YMODEM header block     *)
  80. (*----------------------------------------------------------------------*)
  81.  
  82. PROCEDURE Make_Ymodem_Header;
  83.  
  84. (*----------------------------------------------------------------------*)
  85. (*                                                                      *)
  86. (*       Procedure:  Make_Ymodem_Header                                 *)
  87. (*                                                                      *)
  88. (*       Purpose:    Makes special Ymodem header block                  *)
  89. (*                                                                      *)
  90. (*       Calling sequence:                                              *)
  91. (*                                                                      *)
  92. (*          Make_Ymodem_Header;                                         *)
  93. (*                                                                      *)
  94. (*       Calls:  None                                                   *)
  95. (*                                                                      *)
  96. (*       Remarks:                                                       *)
  97. (*                                                                      *)
  98. (*          This version of PibTerm DOES send the file creation time.   *)
  99. (*                                                                      *)
  100. (*          Format of Ymodem block:                                     *)
  101. (*                                                                      *)
  102. (*             Bytes         Contents                                   *)
  103. (*             -----       ---------------------------------------      *)
  104. (*                                                                      *)
  105. (*               1           SOH                                        *)
  106. (*               2             0                                        *)
  107. (*               3           255                                        *)
  108. (*              4-j          File name in lower case                    *)
  109. (*            j+1-k          File size in bytes                         *)
  110. (*            k+1-l          File creation time/date in Unix format     *)
  111. (*            132-133        CRC of block                               *)
  112. (*                                                                      *)
  113. (*          The first three bytes are added later by the Xmodem send    *)
  114. (*          routine.                                                    *)
  115. (*                                                                      *)
  116. (*----------------------------------------------------------------------*)
  117.  
  118. VAR
  119.    I            : INTEGER;
  120.    J            : INTEGER;
  121.    K            : INTEGER;
  122.    L            : INTEGER;
  123.    CRC          : INTEGER;
  124.    ACK_Ok       : BOOLEAN;
  125.    Int_Ch       : INTEGER;
  126.    Fs1          : REAL;
  127.    Fs2          : REAL;
  128.    S_File_Size  : REAL;
  129.    C_File_Size  : STRING[10];
  130.    OK_File      : BOOLEAN;
  131.  
  132.    Year         : INTEGER;
  133.    Month        : INTEGER;
  134.    Day          : INTEGER;
  135.    Hour         : INTEGER;
  136.    Mins         : INTEGER;
  137.    Secs         : INTEGER;
  138.  
  139.    Date         : REAL;
  140.    OctD         : STRING[20];
  141.    RemO         : REAL;
  142.    Quot         : REAL;
  143.  
  144. (*----------------------------------------------------------------------*)
  145. (*              LowerCase --- convert character to lower case           *)
  146. (*----------------------------------------------------------------------*)
  147.  
  148. FUNCTION LowerCase( C: CHAR ): CHAR;
  149.  
  150. BEGIN (* LowerCase *)
  151.  
  152.    IF ( C IN ['A'..'Z'] ) THEN
  153.       LowerCase := CHR( ORD( C ) - 32 )
  154.    ELSE
  155.       LowerCase := C;
  156.  
  157. END   (* LowerCase *);
  158.  
  159. (*----------------------------------------------------------------------*)
  160.  
  161. PROCEDURE Set_Ymodem_Date( VAR Date  : REAL;
  162.                                Year  : INTEGER;
  163.                                Month : INTEGER;
  164.                                Day   : INTEGER;
  165.                                Hour  : INTEGER;
  166.                                Mins  : INTEGER;
  167.                                Secs  : INTEGER );
  168.  
  169. CONST
  170.    Secs_Per_Year      = 31536000.0;
  171.    Secs_Per_Leap_Year = 31622400.0;
  172.    Secs_Per_Day       = 86400.0;
  173.    Secs_Per_Hour      = 3600.0;
  174.    Secs_Per_Minute    = 60.0;
  175.  
  176. VAR
  177.    RDate     : REAL;
  178.    T         : REAL;
  179.    Leap_Year : BOOLEAN;
  180.  
  181. (* STRUCTURED *) CONST
  182.    Days_Per_Month : ARRAY[1..12] OF BYTE
  183.                     = ( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31 );
  184.  
  185. BEGIN (* Get_Ymodem_Date *)
  186.  
  187.    Date := GMT_Difference * Secs_Per_Hour;
  188.  
  189.    FOR I := 1970 TO ( Year - 1 ) DO
  190.       BEGIN
  191.  
  192.          IF ( I MOD 4 ) = 0 THEN
  193.             T := Secs_Per_Leap_Year
  194.          ELSE
  195.             T := Secs_Per_Year;
  196.  
  197.          Date := Date + T;
  198.  
  199.       END;
  200.  
  201.    IF ( Year MOD 4 ) = 0 THEN
  202.       Days_Per_Month[2] := 29
  203.    ELSE
  204.       Days_Per_Month[2] := 28;
  205.  
  206.    FOR I := 1 TO ( Month - 1 ) DO
  207.       Date := Date + Days_Per_Month[I] * Secs_Per_Day;
  208.  
  209.    Date  := Date + ( Day - 1 ) * Secs_Per_Day    +
  210.                    Hour        * Secs_Per_Hour   +
  211.                    Mins        * Secs_Per_Minute +
  212.                    Secs;
  213.  
  214. END   (* Get_Ymodem_Date *);
  215.  
  216. (*----------------------------------------------------------------------*)
  217.  
  218. BEGIN (* Make_Ymodem_Header *)
  219.                                    (* Zero out block *)
  220.    FOR I := 1 TO 130 DO
  221.       Sector_Data[I] := 0;
  222.                                    (* File name      *)
  223.    L := LENGTH( FileName );
  224.  
  225.    FOR I := 1 TO L DO
  226.       Sector_Data[I] := ORD( LowerCase(FileName[I]) );
  227.  
  228.                                    (* File size in Ascii *)
  229.    Fs1 := File_Entry.File_Size[1];
  230.    Fs2 := File_Entry.File_Size[2];
  231.  
  232.    IF Fs1 < 0 Then Fs1 := Fs1 + 65536.0;
  233.    IF Fs2 < 0 Then Fs2 := Fs2 + 65536.0;
  234.  
  235.    S_File_Size := Fs2 * 65536.0 + Fs1;
  236.  
  237.    STR( S_File_Size:10:0, C_File_Size );
  238.  
  239.    J      := 1;
  240.  
  241.    WHILE( C_File_Size[J] = ' ' ) DO
  242.       J := J + 1;
  243.                                    (* Insert file size in block *)
  244.  
  245.    Sector_Data[L + 1] := ORD(' ');
  246.  
  247.    I      := L + 2;
  248.  
  249.    FOR K := J TO 10 DO
  250.      BEGIN
  251.         Sector_Data[I] := ORD( C_File_Size[K] );
  252.         I              := I + 1;
  253.      END;
  254.                                    (* Get file date and time *)
  255.    WITH File_Entry DO
  256.       BEGIN
  257.  
  258.          Hour  := ( File_Time SHR 11    ) AND $1F;
  259.          Mins  := ( File_Time AND $07E0 ) SHR 5;
  260.          Secs  := ( File_Time AND $001F ) * 2;
  261.  
  262.          Year  := 1980 + ( ( File_Date SHR 9 ) AND $7F );
  263.          Month := ( File_Date AND $01E0 ) SHR 5;
  264.          Day   := File_Date AND $001F;
  265.  
  266.       END;
  267.                                    (* Convert DOS time and date to *)
  268.                                    (* number of seconds since      *)
  269.                                    (* January 1, 1970.             *)
  270.  
  271.    Set_Ymodem_Date( Date, Year, Month, Day, Hour, Mins, Secs );
  272.  
  273.                                    (* Convert date to octal string *)
  274.  
  275.    OctD := '';
  276.  
  277.    REPEAT
  278.  
  279.       Quot := INT( Date / 8.0 );
  280.       Remo := Date - 8.0 * Quot;
  281.  
  282.       OctD := CHR( TRUNC( Remo ) + ORD( '0' ) ) + OctD;
  283.  
  284.       Date := Quot;
  285.  
  286.    UNTIL( Date <= 0.0 );
  287.                                    (* Insert octal date into Ymodem block *)
  288.    Sector_Data[I] := ORD(' ');
  289.  
  290.    FOR K := 1 TO LENGTH( OctD ) DO
  291.       BEGIN
  292.          I              := I + 1;
  293.          Sector_Data[I] := ORD(OctD[K]);
  294.       END;
  295.                                    (* Compute CRC *)
  296.    Crc := 0;
  297.  
  298.    FOR I := 1 TO 128 DO
  299.       Crc := Update_Crc( Crc , Sector_Data[I] );
  300.  
  301.    Sector_Data[129] := HI( Crc );
  302.    Sector_Data[130] := LO( Crc );
  303.  
  304. END   (* Make_Ymodem_Header *);
  305.  
  306. (*----------------------------------------------------------------------*)
  307. (*          Get_Ymodem_File_Name  --- get file name for upload          *)
  308. (*----------------------------------------------------------------------*)
  309.  
  310. PROCEDURE Get_Ymodem_File_Name( VAR OK_File : BOOLEAN );
  311.  
  312. VAR
  313.    I : INTEGER;
  314.  
  315. BEGIN (* Get_Ymodem_File_Name *)
  316.  
  317.    FileName := '';
  318.    I        := 1;
  319.  
  320.    WHILE( File_Entry.File_Name[I] <> CHR( 0 ) ) DO
  321.       BEGIN
  322.          FileName := FileName + File_Entry.File_Name[I];
  323.          I        := I + 1;
  324.       END;
  325.  
  326.    OK_File := ( File_Entry.File_Attr AND
  327.                 ( Dir_Attr_Volume_Label + Dir_Attr_Subdirectory ) = 0 );
  328.  
  329.                                    (* If host mode, make sure file *)
  330.                                    (* is on xferlist!              *)
  331.    IF Host_Mode THEN
  332.       OK_File := Scan_Xfer_List( FileName );
  333.  
  334. END   (* Get_Ymodem_File_Name *);
  335.  
  336. (*----------------------------------------------------------------------*)
  337. (*                Perform_Upload --- Do the upload                      *)
  338. (*----------------------------------------------------------------------*)
  339.  
  340. PROCEDURE Perform_Upload;
  341.  
  342. BEGIN (* Perform_Upload *)
  343.  
  344.    Writelne('  Uploading: ' + FileName , TRUE );
  345.  
  346.    Send_Xmodem_File( TRUE );
  347.  
  348.    TextColor( Menu_Text_Color );
  349.  
  350. END   (* Perform_Upload *);
  351.  
  352. (*----------------------------------------------------------------------*)
  353. (*  Send_Null_File_Name --- Send null file name to stop batch transfer  *)
  354. (*----------------------------------------------------------------------*)
  355.  
  356. PROCEDURE Send_Null_File_Name;
  357.  
  358. BEGIN (* Send_Null_File_Name *)
  359.                                    (* Purge reception *)
  360.    REPEAT
  361.       Async_Receive_With_Timeout( One_Second , Int_Ch );
  362.    UNTIL ( Int_Ch = TimeOut );
  363.  
  364.                                    (* Send null file name block 0 *)
  365.    Async_Send( CHR( SOH ) );
  366.    Async_Send( CHR(   0 ) );
  367.    Async_Send( CHR( 255 ) );
  368.  
  369.    FOR I := 1 TO 130 DO
  370.       Async_Send( CHR( 0 ) );
  371.  
  372.    WRITELN(' ');
  373.    WRITELN('  Sending null file name to terminate batch transfer ...');
  374.  
  375.                                    (* Wait for ACK                    *)
  376.  
  377.    Async_Receive_With_TimeOut( Ten_Seconds , Int_Ch );
  378.  
  379.    IF ( Int_Ch = ACK ) THEN
  380.       BEGIN
  381.          Writelne(' ', TRUE);
  382.          Writelne('  Host system ACKnowledged end of batch.', TRUE);
  383.       END;
  384.  
  385. END   (* Send_Null_File_Name *);
  386.  
  387.  
  388. (*----------------------------------------------------------------------*)
  389.  
  390. BEGIN (* Send_Ymodem_File *)
  391.                                    (* Open display window for transfers  *)
  392.    Save_Screen( Local_Save );
  393.  
  394.    Draw_Menu_Frame( 2, 2, 79, 24, Menu_Frame_Color,
  395.                     Menu_Text_Color,
  396.                     'Batch file upload using Ymodem' );
  397.  
  398.    Writelne( 'Batch file upload using Ymodem' , FALSE );
  399.  
  400.    Window( 3, 3, 78, 23 );
  401.                                    (* Get file name pattern to send *)
  402.    File_Pattern  := FileName;
  403.                                    (* See if we can find anything to *)
  404.                                    (* be sent.                       *)
  405.  
  406.    Stop_Send    := ( Dir_Find_First_File( File_Pattern, File_Entry ) <> 0 );
  407.  
  408.    IF Stop_Send THEN
  409.       Writelne('  No files found to send.' , TRUE );
  410.                                    (* Loop over file names         *)
  411.    WHILE( NOT Stop_Send ) DO
  412.       BEGIN
  413.                                    (* Get file name *)
  414.  
  415.          Get_Ymodem_File_Name( OK_File );
  416.  
  417.                                    (* Get Ymodem header block       *)
  418.          IF OK_File THEN
  419.             BEGIN
  420.  
  421.                IF NOT Stop_Send THEN
  422.                   Make_Ymodem_Header;
  423.  
  424.                                    (* Send the file itself          *)
  425.  
  426.                IF NOT Stop_Send THEN
  427.                   Perform_Upload;
  428.  
  429.             END;
  430.                                   (* See if more files to transfer *)
  431.  
  432.          Stop_Send := Stop_Send OR ( Dir_Find_Next_File( File_Entry ) <> 0 );
  433.  
  434.       END (* While *);
  435.                                    (* Send null file name to indicate *)
  436.                                    (* no more files                   *)
  437.    Send_Null_File_Name;
  438.                                    (* Indicate end of transfer    *)
  439.    Writelne(' ', TRUE);
  440.  
  441.    RvsVideoOn ( Menu_Text_Color, BackGround_Color );
  442.  
  443.    Writelne('  Ymodem batch transfer complete.', TRUE);
  444.  
  445.    RvsVideoOff( Menu_Text_Color, BackGround_COlor );
  446.  
  447.    DELAY( Two_Second_Delay );
  448.                                    (* Remove batch transfer window *)
  449.    Restore_Screen( Local_Save );
  450.  
  451.    Reset_Global_Colors;
  452.  
  453. END   (* Send_Ymodem_File *);
  454.